with System;
with Ada.Unchecked_Conversion;

package body FT2.Outlines is

   -- Outline decompose handling

   function To_Ada is new Ada.Unchecked_Conversion
     (System.Address, FT_Outline_Funcs_Ref);

   type FT_Outline_MoveToFunc is access function
     (To : FT_Vector;
      User : System.Address)
      return FT_Int;
   pragma Convention (C, FT_Outline_MoveToFunc);

   type FT_Outline_LineToFunc is access function
     (To : FT_Vector;
      User : System.Address)
      return FT_Int;
   pragma Convention (C, FT_Outline_LineToFunc);

   type FT_Outline_ConicToFunc is access function
     (Control : FT_Vector;
      To : FT_Vector;
      User : System.Address)
      return FT_Int;
   pragma Convention (C, FT_Outline_ConicToFunc);

   type FT_Outline_CubicToFunc is access function
     (Control1 : FT_Vector;
      Control2 : FT_Vector;
      To : FT_Vector;
      User : System.Address)
      return FT_Int;
   pragma Convention (C, FT_Outline_CubicToFunc);

   type C_FT_Outline_Funcs is record
      Move_To : FT_Outline_MoveToFunc;
      Line_To : FT_Outline_LineToFunc;
      Conic_To : FT_Outline_ConicToFunc;
      Cubic_To : FT_Outline_CubicToFunc;

      Shift : FT_Int := 0;
      CDelta : FT_Pos := Zero;
   end record;
   pragma Convention (C, C_FT_Outline_Funcs);

   function C_Move_To
     (To : FT_Vector;
      User : System.Address)
      return FT_Int;
   pragma Convention (C, C_Move_To);

   function C_Line_To
     (To : FT_Vector;
      User : System.Address)
      return FT_Int;
   pragma Convention (C, C_Line_To);

   function C_Conic_To
     (Control : FT_Vector;
      To : FT_Vector;
      User : System.Address)
      return FT_Int;
   pragma Convention (C, C_Conic_To);

   function C_Cubic_To
     (Control1 : FT_Vector;
      Control2 : FT_Vector;
      To : FT_Vector;
      User : System.Address)
      return FT_Int;
   pragma Convention (C, C_Cubic_To);

   -- Raster param handling

   function To_Ada is new Ada.Unchecked_Conversion
     (System.Address, FT_Raster_Params_Ref);

   type FT_Span_Func is access procedure
     (Y : FT_Int;
      Count : FT_Int;
      Spans : FT_Spans_Ptr;
      User : System.Address);
   pragma Convention (C, FT_Span_Func);

   type FT_Raster_Bit_Test_Func is access function
     (Y : FT_Int;
      X : FT_Int;
      User : System.Address)
      return FT_Int;
   pragma Convention (C, FT_Raster_Bit_Test_Func);

   type FT_Bit_Set_Func is access procedure
     (Y : FT_Int;
      X : FT_Int;
      User : System.Address);
   pragma Convention (C, FT_Bit_Set_Func);

   type C_FT_Raster_Params is record
      Target : FT_Bitmap_Ptr; -- const in fact
      Source : System.Address;
      Flags : FT_Raster_Flag;

      Gray_Spans : FT_Span_Func;
      Black_Spans : FT_Span_Func;
      Bit_Test : FT_Raster_Bit_Test_Func;
      Bit_Set : FT_Bit_Set_Func;

      User : System.Address;
      Clip_Box : FT_BBox;
   end record;
   pragma Convention (C, C_FT_Raster_Params);

   procedure C_Gray_Spans
     (Y : FT_Int;
      Count : FT_Int;
      Spans : FT_Spans_Ptr;
      User : System.Address);
   pragma Convention (C, C_Gray_Spans);

   procedure C_Black_Spans
     (Y : FT_Int;
      Count : FT_Int;
      Spans : FT_Spans_Ptr;
      User : System.Address);
   pragma Convention (C, C_Black_Spans);

   function C_Bit_Test
     (Y : FT_Int;
      X : FT_Int;
      User : System.Address)
      return FT_Int;
   pragma Convention (C, C_Bit_Test);

   procedure C_Bit_Set
     (Y : FT_Int;
      X : FT_Int;
      User : System.Address);
   pragma Convention (C, C_Bit_Set);


   ---------------
   -- C_Move_To --
   ---------------

   function C_Move_To
     (To : FT_Vector;
      User : System.Address)
      return FT_Int
   is
   begin
      return To_Ada (User).Move_To (To);
   end C_Move_To;

   ---------------
   -- C_Line_To --
   ---------------

   function C_Line_To
     (To : FT_Vector;
      User : System.Address)
      return FT_Int
   is
   begin
      return To_Ada (User).Line_To (To);
   end C_Line_To;

   ----------------
   -- C_Conic_To --
   ----------------

   function C_Conic_To
     (Control : FT_Vector;
      To : FT_Vector;
      User : System.Address)
      return FT_Int
   is
   begin
      return To_Ada (User).Conic_To (Control, To);
   end C_Conic_To;

   ----------------
   -- C_Cubic_To --
   ----------------

   function C_Cubic_To
     (Control1 : FT_Vector;
      Control2 : FT_Vector;
      To : FT_Vector;
      User : System.Address)
      return FT_Int
   is
   begin
      return To_Ada (User).Cubic_To (Control1, Control2, To);
   end C_Cubic_To;

   procedure C_Gray_Spans
     (Y : FT_Int;
      Count : FT_Int;
      Spans : FT_Spans_Ptr;
      User : System.Address)
   is
   begin
      To_Ada (User).Gray_Spans (Y, To_Array (Spans, Count));
   end C_Gray_Spans;


   procedure C_Black_Spans
     (Y : FT_Int;
      Count : FT_Int;
      Spans : FT_Spans_Ptr;
      User : System.Address)
   is
   begin
      To_Ada (User).Black_Spans (Y, To_Array (Spans, Count));
   end C_Black_Spans;

   function C_Bit_Test
     (Y : FT_Int;
      X : FT_Int;
      User : System.Address)
      return FT_Int
   is
   begin
      return Boolean'Pos (To_Ada (User).Bit_Test (Y, X));
   end C_Bit_Test;

   procedure C_Bit_Set
     (Y : FT_Int;
      X : FT_Int;
      User : System.Address)
   is
   begin
      To_Ada (User).Bit_Set (Y, X);
   end C_Bit_Set;

   -----------------
   -- Outline_New --
   -----------------

   procedure Outline_New
     (Library : FT_Library;
      Num_Points : FT_UInt;
      Num_Contours : FT_Int;
      Outline : out FT_Outline;
      Error : out FT_Error)
   is
      function Internal
        (Library : FT_Library;
         Num_Points : FT_UInt;
         Num_Contours : FT_Int;
         Outline : System.Address)
         return FT_Error;
      pragma Import (C, Internal, "FT_Outline_New");
   begin
      Error := Internal (Library, Num_Points, Num_Contours, Outline'Address);
   end Outline_New;

   ------------------
   -- Outline_Done --
   ------------------

   procedure Outline_Done
     (Library : FT_Library;
      Outline : in out FT_Outline;
      Error : out FT_Error)
   is
      function Internal
        (Library : FT_Library;
         Outline : System.Address)
         return FT_Error;
      pragma Import (C, Internal, "FT_Outline_Done");
   begin
      Error := Internal (Library, Outline'Address);
   end Outline_Done;

   ----------
   -- Copy --
   ----------

   procedure Copy
     (Source : FT_Outline;
      Target : in out FT_Outline;
      Error : out FT_Error)
   is
      function Internal
        (Source : FT_Outline;
         Target : System.Address)
         return FT_Error;
      pragma Import (C, Internal, "FT_Outline_Copy");
   begin
      Error := Internal (Source, Target'Address);
   end Copy;

   --------------
   -- Embolden --
   --------------

   procedure Embolden
     (Outline : in out FT_Outline;
      Strength : FT_Pos;
      Error : out FT_Error)
   is
      function Internal
        (Outline : System.Address;
         Strength : FT_Pos)
         return FT_Error;
      pragma Import (C, Internal, "FT_Outline_Embolden");
   begin
      Error := Internal (Outline'Address, Strength);
   end Embolden;

   -----------
   -- Check --
   -----------

   procedure Check
     (Outline : FT_Outline;
      Error : out FT_Error)
   is
      function Internal
        (Outline : FT_Outline)
         return FT_Error;
      pragma Import (C, Internal, "FT_Outline_Check");
   begin
      Error := Internal (Outline);
   end Check;

   --------------
   -- Get_BBox --
   --------------

   procedure Get_BBox
     (Outline : FT_Outline;
      BBox : out FT_BBox;
      Error : out FT_Error)
   is
      function Internal
        (Outline : FT_Outline;
         BBox : System.Address)
         return FT_Error;
      pragma Import (C, Internal, "FT_Outline_Get_BBox");
   begin
      Error := Internal (Outline, BBox'Address);
   end Get_BBox;

   ---------------
   -- Decompose --
   ---------------

--     procedure Decompose
--       (Outline : FT_Outline;
--        Funcs : FT_Outline_Funcs;
--        User : System.Address;
--        Error : out FT_Error)
--     is
--     begin
--        --  Generated stub: replace with real body!
--        raise Program_Error;
--     end Decompose;

   ---------------
   -- Decompose --
   ---------------

   procedure Decompose
     (Outline : FT_Outline;
      Funcs : access FT_Outline_Funcs'Class;
--        Shift : FT_Int := 0;
--        CDelta : FT_Pos := Zero;
      Error : out FT_Error)
   is
      function Internal
        (Outline : FT_Outline;
         Funcs : C_FT_Outline_Funcs;
         User : System.Address)
         return FT_Error;
      pragma Import (C, Internal, "FT_Outline_Decompose");
      C_Funcs : C_FT_Outline_Funcs;
   begin
      C_Funcs := (C_Move_To'Access,
                  C_Line_To'Access,
                  C_Conic_To'Access,
                  C_Cubic_To'Access,
                  Funcs.Shift,
                  Funcs.CDelta);

      Error := Internal (Outline, C_Funcs, Funcs.all'Address);
   end Decompose;

   ----------------
   -- Get_Bitmap --
   ----------------

   procedure Get_Bitmap
     (Library : FT_Library;
      Outline : FT_Outline;
      Bitmap : in out FT_Bitmap;
      Error : out FT_Error)
   is
      function Internal
        (Library : FT_Library;
         Outline : FT_Outline;
         Bitmap : System.Address)
         return FT_Error;
      pragma Import (C, Internal, "FT_Outline_Get_Bitmap");
   begin
      Error := Internal (Library, Outline, Bitmap'Address);
   end Get_Bitmap;

   ------------
   -- Render --
   ------------

   procedure Render
     (Library : FT_Library;
      Outline : FT_Outline;
      Params : access FT_Raster_Params'Class;
      Error : out FT_Error)
   is
      function Internal
        (Library : FT_Library;
         Outline : FT_Outline;
         Params : C_FT_Raster_Params)
         return FT_Error;
      pragma Import (C, Internal, "FT_Outline_Render");
      C_Params : C_FT_Raster_Params;
   begin
      C_Params := (Params.Target,
                   Params.Source,
                   Params.Flags,
                   C_Gray_Spans'Access,
                   C_Black_Spans'Access,
                   C_Bit_Test'Access,
                   C_Bit_Set'Access,
                   Params.all'Address,
                   Params.Clip_Box);

      Error := Internal (Library, Outline, C_Params);
   end Render;

end FT2.Outlines;
